Imports System.Text
Imports System.Threading

Public Class MemChannel

    Private Const DEF_SIZE = 32 * 1024

    Private Const NUM_MSG As Integer = 0
    Private Const MAP_SIZE As Integer = 4
    Private Const P_COUNT As Integer = 8
    Private Const ADDR_FIRST As Integer = 12
    Private Const OFF_PIDLOCK As Integer = 16
    Private Const ADDR_FREE As Integer = 20

    Private Const END_BLOCK As Integer = ADDR_FREE + 4

    Private Const PAD_END_SIZE As Integer = 8



    Public ReadOnly chaName As String
    Public ReadOnly chaSize As Integer
    Private chaMap As MemMap
    Private tempNumMsg As Integer
    Private tempAddrFirst As Integer
    Private tempAddrFree As Integer
    Private eventHandle As Integer
    Private chid As Integer

    Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As IntPtr, ByVal bManualReset As Integer, ByVal bInitialState As Integer, ByVal lpName As String) As Integer
    Private Declare Function SetEvent Lib "kernel32" Alias "SetEvent" (ByVal hEvent As Integer) As Integer
    Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As IntPtr, ByVal bInitialOwner As Integer, ByVal lpName As String) As Integer
    Private Declare Function ReleaseMutex Lib "kernel32" Alias "ReleaseMutex" (ByVal hMutex As Integer) As Integer
    Private Declare Function GetLastError Lib "kernel32" Alias "GetLastError" () As Integer
    Private Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As Integer
    Private Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Integer) As Integer





    Public Sub New(ByVal name As String, ByVal size As Integer)
        chaSize = size + size Mod 4
        chaName = name


        eventHandle = CreateEvent(IntPtr.Zero, 0, 0, "Global/FMCHAEVENT" + name)
        If eventHandle = 0 Then
            Throw New Exception("CrateEvent fail:" + GetLastError().ToString)
        End If

        chaMap = New MemMap("FMCHA" + name, size)
        Lock(False)
        If chaMap.IsNew Then
            chaMap.writeInt32(NUM_MSG, 0) ' Messages in channel
            chaMap.writeInt32(ADDR_FIRST, END_BLOCK) ' Address of first Message
            chaMap.writeInt32(ADDR_FREE, END_BLOCK) 'Address of free zone
            chaMap.writeInt32(MAP_SIZE, size) ' Size of memory map
            chaMap.writeInt32(P_COUNT, 1) 'ID for this instance
            chid = 1
        Else
            chaSize = chaMap.readInt32(MAP_SIZE)
            chid = chaMap.readInt32(P_COUNT) + 1
            chaMap.writeInt32(P_COUNT, chid)
        End If
        Unlock(False)

    End Sub

    Public Sub New(ByVal name As String)
        Me.new(name, DEF_SIZE)
    End Sub

    Public ReadOnly Property numMsg() As Integer
        Get
            Lock(True)
            Unlock(False)
            Return tempNumMsg
        End Get
    End Property

    Public ReadOnly Property bufSize() As Integer
        Get
            Return chaSize
        End Get
    End Property
    Public ReadOnly Property id() As Integer
        Get
            Return chid
        End Get
    End Property

    Public Sub close()
        chaMap.close()
        CloseHandle(eventHandle)
        chaMap = Nothing
    End Sub

    Private Sub Lock(ByVal pRead As Boolean)
        chaMap.interLock(OFF_PIDLOCK)
        If Not pRead Then Exit Sub
        tempNumMsg = chaMap.readInt32(NUM_MSG)
        tempAddrFirst = chaMap.readInt32(ADDR_FIRST)
        tempAddrFree = chaMap.readInt32(ADDR_FREE)
    End Sub
    Private Sub Unlock(ByVal write As Boolean)

        If write Then
            chaMap.writeInt32(NUM_MSG, tempNumMsg)
            chaMap.writeInt32(ADDR_FIRST, tempAddrFirst)
            chaMap.writeInt32(ADDR_FREE, tempAddrFree)
        End If
        'dumpChain()
        'If write Then testChain()
        chaMap.interUnlock(OFF_PIDLOCK)
    End Sub

    Private Const SLEEPWAIT As Integer = 10
    Public Sub putmsgwait(ByVal msg As String, ByVal timeout As Integer)
        Dim wtimeout As Integer = 0
        While True
            Try
                p_putMsg(msg)
                Exit Sub
            Catch ex As OutOfMemoryException
                System.Threading.Thread.Sleep(SLEEPWAIT)
                wtimeout += SLEEPWAIT
                If wtimeout > timeout Then
                    Throw ex
                End If
            End Try
        End While

    End Sub
    Public Sub putMsg(ByVal msg As String)
        p_putMsg(msg)
    End Sub
    Private Sub p_putMsg(ByVal msg As String)
        Dim msgSize As Integer = (msg.Length * 2) + 4
        Dim freeSize As Integer
        Dim block1size As Integer
        Dim block2size As Integer
        Lock(True)
        If tempAddrFree < tempAddrFirst Then
            block1size = tempAddrFirst - tempAddrFree
            block2size = 0
        Else
            block1size = chaSize - tempAddrFree
            block2size = tempAddrFirst - END_BLOCK
            If block1size < PAD_END_SIZE Then
                block1size = block2size
                tempAddrFree = END_BLOCK
                block2size = 0
            End If
        End If
        freeSize = block1size + block2size

        If msgSize + PAD_END_SIZE > freeSize Then
            Unlock(False)
            Throw New OutOfMemoryException("Channel:" + chaName + " Buffer Full")
        End If
        If msgSize <= block1size Then
            chaMap.writeInt32(tempAddrFree, msgSize)
            chaMap.writeString(tempAddrFree + 4, msg)
            tempAddrFree += msgSize
        Else
            block1size -= 4
            Dim tempMsg As String = msg.Substring((block1size / 2))
            chaMap.writeInt32(tempAddrFree, msgSize)
            chaMap.writeString(tempAddrFree + 4, msg.Substring(0, (block1size) / 2))
            chaMap.writeString(END_BLOCK, tempMsg)
            tempAddrFree = END_BLOCK + tempMsg.Length * 2
        End If
        tempNumMsg += 1
        Unlock(True)
        If tempNumMsg = 1 Then
            SetEvent(eventHandle)
        End If

    End Sub

    Private Sub waitForMsg()
        While True
            Lock(True)
            If tempNumMsg > 0 Then Exit Sub
            Unlock(False)
            WaitForSingleObject(eventHandle, 2000)
        End While
    End Sub

    Public Function getMsg() As String
        Dim msgSize As Integer
        Dim block1size As Integer
        Dim msg1 As String
        Dim msg2 As String
        waitForMsg()

        msgSize = chaMap.readInt32(tempAddrFirst)
        tempAddrFirst += 4
        msgSize -= 4
        block1size = (chaSize - tempAddrFirst)
        If msgSize > block1size Then
            msg1 = chaMap.readString(tempAddrFirst, block1size / 2)
            tempAddrFirst = END_BLOCK
            msgSize -= block1size
        End If
        msg2 = chaMap.readString(tempAddrFirst, msgSize / 2)
        tempAddrFirst += msgSize
        tempNumMsg -= 1
        If tempNumMsg = 0 Then
            tempAddrFirst = END_BLOCK
            tempAddrFree = END_BLOCK
        Else
            If chaSize - tempAddrFirst < PAD_END_SIZE Then
                tempAddrFirst = END_BLOCK
            End If
        End If
        Unlock(True)
        'testChain()
        If msg1 Is Nothing Then
            Return msg2
        Else
            Return msg1 + msg2
        End If

    End Function

    Private Sub testChain()
        Dim wnumMsg As Integer = tempNumMsg
        Dim wFirst As Integer = tempAddrFirst
        Dim wFree As Integer = tempAddrFree
        Dim wSize As Integer
        While wnumMsg > 0
            If chaSize - wFirst < PAD_END_SIZE Then
                wFirst = END_BLOCK
            End If
            wSize = chaMap.readInt32(wFirst)
            If wSize < 0 Or wSize > chaSize Then
                dumpChain()
                Throw New Exception("1-MemMap is corrupted in msg:" + (tempNumMsg - wnumMsg).ToString + " size=" + wSize.ToString)
            End If
            wFirst += wSize
            If wFirst > chaSize Then
                wFirst = (wFirst - chaSize) + END_BLOCK

            End If
            wnumMsg -= 1
        End While

        If wFree <> wFirst Then
            dumpChain()
            Throw New Exception("2-MemMap is corrupted in msg:" + (tempNumMsg - wnumMsg).ToString + " size=" + wSize.ToString)
        End If
    End Sub
    Private Sub dumpChain()
        Dim wnumMsg As Integer = tempNumMsg
        Dim wFirst As Integer = tempAddrFirst
        Dim wFree As Integer = tempAddrFree
        Dim wSize As Integer
        Dim wFirst2 As Integer
        Dim wblock1 As Integer
        Dim wblock2 As Integer
        System.Console.Out.WriteLine("-----------------------------------")
        While wnumMsg > 0
            If chaSize - wFirst < PAD_END_SIZE Then
                wFirst = END_BLOCK
            End If
            wSize = chaMap.readInt32(wFirst)
            System.Console.Out.Write("msg(" + (tempNumMsg - wnumMsg).ToString + ")" + wFirst.ToString + ":" + wSize.ToString + "-")
            If wSize < 0 Or wSize > chaSize Then
                Exit Sub
            End If
            wFirst2 = wFirst + wSize
            If wFirst2 > chaSize Then
                wblock1 = (chaSize - (wFirst + 4)) / 2
                wblock2 = ((wFirst2 - chaSize) - 4) / 2
                If wblock1 > 0 Then
                    System.Console.Out.Write(chaMap.readString(wFirst + 4, wblock1))
                End If
                System.Console.Out.WriteLine(chaMap.readString(END_BLOCK, wblock2))
                wFirst = (wFirst2 - chaMap.mapSize) + END_BLOCK
            Else
                System.Console.Out.WriteLine(chaMap.readString(wFirst + 4, (wSize - 4) / 2))
                wFirst = wFirst2
            End If
            wnumMsg -= 1
        End While

        If wFree <> wFirst Then
            System.Console.Out.WriteLine("Free <> First")
        End If
    End Sub
End Class
